home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 002 / emacssrc.arc / EVAL.C < prev    next >
Encoding:
C/C++ Source or Header  |  1987-02-02  |  11.5 KB  |  459 lines
  1. /*    EVAL.C:    Expresion evaluation functions for
  2.  
  3.         MicroEMACS
  4.  
  5.  
  6.  
  7.     written 1986 by Daniel Lawrence                */
  8.  
  9.  
  10.  
  11. #include    <stdio.h>
  12.  
  13. #include    "estruct.h"
  14.  
  15. #include    "edef.h"
  16.  
  17. #include    "evar.h"
  18.  
  19.  
  20.  
  21. #if    MEGAMAX & ST520
  22.  
  23. overlay    "eval"
  24.  
  25. #endif
  26.  
  27.  
  28.  
  29. char value[80];        /* buffer to return value in */
  30.  
  31.  
  32.  
  33. varinit()        /* initialize the user variable list */
  34.  
  35.  
  36.  
  37. {
  38.  
  39.     register int i;
  40.  
  41.  
  42.  
  43.     for (i=0; i < MAXVARS; i++)
  44.  
  45.         uv[i].u_name[0] = 0;
  46.  
  47. }
  48.  
  49.  
  50.  
  51. char *gtfun(fname)    /* evaluate a function */
  52.  
  53.  
  54.  
  55. char *fname;        /* name of function to evaluate */
  56.  
  57.  
  58.  
  59. {
  60.  
  61.     register int fnum;        /* index to function to eval */
  62.  
  63.     register int status;        /* return status */
  64.  
  65.     char arg1[NSTRING];        /* value of first argument */
  66.  
  67.     char arg2[NSTRING];        /* value of second argument */
  68.  
  69.     char arg3[NSTRING];        /* value of third argument */
  70.  
  71.     static char result[2 * NSTRING];    /* string result */
  72.  
  73.  
  74.  
  75.     /* look the function up in the function table */
  76.  
  77.     fname[3] = 0;    /* only first 3 chars significant */
  78.  
  79.     for (fnum = 0; fnum < NFUNCS; fnum++)
  80.  
  81.         if (strcmp(fname, funcs[fnum].f_name) == 0)
  82.  
  83.             break;
  84.  
  85.  
  86.  
  87.     /* return errorm on a bad reference */
  88.  
  89.     if (fnum == NFUNCS)
  90.  
  91.         return(errorm);
  92.  
  93.  
  94.  
  95.     /* retrieve the first argument */
  96.  
  97.     if ((status = macarg(arg1)) != TRUE)
  98.  
  99.         return(errorm);
  100.  
  101.  
  102.  
  103.     /* if needed, retrieve the second argument */
  104.  
  105.     if (funcs[fnum].f_type >= DYNAMIC) {
  106.  
  107.         if ((status = macarg(arg2)) != TRUE)
  108.  
  109.             return(errorm);
  110.  
  111.  
  112.  
  113.         /* if needed, retrieve the third argument */
  114.  
  115.         if (funcs[fnum].f_type >= TRINAMIC)
  116.  
  117.             if ((status = macarg(arg3)) != TRUE)
  118.  
  119.                 return(errorm);
  120.  
  121.     }
  122.  
  123.  
  124.  
  125.     /* and now evaluate it! */
  126.  
  127.     switch (fnum) {
  128.  
  129.         case UFADD:    return(itoa(atoi(arg1) + atoi(arg2)));
  130.  
  131.         case UFSUB:    return(itoa(atoi(arg1) - atoi(arg2)));
  132.  
  133.         case UFTIMES:    return(itoa(atoi(arg1) * atoi(arg2)));
  134.  
  135.         case UFDIV:    return(itoa(atoi(arg1) / atoi(arg2)));
  136.  
  137.         case UFMOD:    return(itoa(atoi(arg1) % atoi(arg2)));
  138.  
  139.         case UFNEG:    return(itoa(-atoi(arg1)));
  140.  
  141.         case UFCAT:    strcpy(result, arg1);
  142.  
  143.                 return(strcat(result, arg2));
  144.  
  145.         case UFLEFT:    return(strncpy(result, arg1, atoi(arg2)));
  146.  
  147.         case UFRIGHT:    return(strcpy(result, &arg1[atoi(arg2)-1]));
  148.  
  149.         case UFMID:    return(strncpy(result, &arg1[atoi(arg2)-1],
  150.  
  151.                     atoi(arg3)));
  152.  
  153.         case UFNOT:    return(ltos(stol(arg1) == FALSE));
  154.  
  155.         case UFEQUAL:    return(ltos(atoi(arg1) == atoi(arg2)));
  156.  
  157.         case UFLESS:    return(ltos(atoi(arg1) < atoi(arg2)));
  158.  
  159.         case UFGREATER:    return(ltos(atoi(arg1) > atoi(arg2)));
  160.  
  161.         case UFSEQUAL:    return(ltos(strcmp(arg1, arg2) == 0));
  162.  
  163.         case UFSLESS:    return(ltos(strcmp(arg1, arg2) < 0));
  164.  
  165.         case UFSGREAT:    return(ltos(strcmp(arg1, arg2) > 0));
  166.  
  167.         case UFIND:    return(getval(arg1));
  168.  
  169.     }
  170.  
  171.  
  172.  
  173.     exit(-11);    /* never should get here */
  174.  
  175. }
  176.  
  177.  
  178.  
  179. char *gtusr(vname)    /* look up a user var's value */
  180.  
  181.  
  182.  
  183. char *vname;        /* name of user variable to fetch */
  184.  
  185.  
  186.  
  187. {
  188.  
  189.  
  190.  
  191.     register int vnum;    /* ordinal number of user var */
  192.  
  193.  
  194.  
  195.     /* scan the list looking for the user var name */
  196.  
  197.     for (vnum = 0; vnum < MAXVARS; vnum++)
  198.  
  199.         if (strcmp(vname, uv[vnum].u_name) == 0)
  200.  
  201.             break;
  202.  
  203.  
  204.  
  205.     /* return errorm on a bad reference */
  206.  
  207.     if (vnum == MAXVARS)
  208.  
  209.         return(errorm);
  210.  
  211.  
  212.  
  213.     return(uv[vnum].u_value);
  214.  
  215. }
  216.  
  217.  
  218.  
  219. char *gtenv(vname)
  220.  
  221.  
  222.  
  223. char *vname;        /* name of environment variable to retrieve */
  224.  
  225.  
  226.  
  227. {
  228.  
  229.     register int vnum;    /* ordinal number of var refrenced */
  230.  
  231.  
  232.  
  233.     /* scan the list, looking for the referenced name */
  234.  
  235.     for (vnum = 0; vnum < NEVARS; vnum++)
  236.  
  237.         if (strcmp(vname, envars[vnum]) == 0)
  238.  
  239.             break;
  240.  
  241.  
  242.  
  243.     /* return errorm on a bad reference */
  244.  
  245.     if (vnum == NEVARS)
  246.  
  247.         return(errorm);
  248.  
  249.  
  250.  
  251.     /* otherwise, fetch the appropriate value */
  252.  
  253.     switch (vnum) {
  254.  
  255.         case EVFILLCOL:    return(itoa(fillcol));
  256.  
  257.         case EVPAGELEN:    return(itoa(term.t_nrow + 1));
  258.  
  259.         case EVCURCOL:    return(itoa(getccol(FALSE)));
  260.  
  261.         case EVCURLINE: return(itoa(getcline()));
  262.  
  263.         case EVRAM:    return(itoa((int)(envram / 1024l)));
  264.  
  265.         case EVFLICKER:    return(ltos(flickcode));
  266.  
  267.         case EVCURWIDTH:return(itoa(term.t_nrow));
  268.  
  269.         case EVCBUFNAME:return(curbp->b_bname);
  270.  
  271.         case EVCFNAME:    return(curbp->b_fname);
  272.  
  273.         case EVSRES:    return(sres);
  274.  
  275.         case EVDEBUG:    return(ltos(macbug));
  276.  
  277.         case EVSTATUS:    return(ltos(cmdstatus));
  278.  
  279.         case EVPALETTE:    return(palstr);
  280.  
  281.     }
  282.  
  283. }
  284.  
  285.  
  286.  
  287. int setvar(f, n)        /* set a variable */
  288.  
  289.  
  290.  
  291. int f;        /* default flag */
  292.  
  293. int n;        /* numeric arg (can overide prompted value) */
  294.  
  295.  
  296.  
  297. {
  298.  
  299.     register int vnum;    /* ordinal number of var refrenced */
  300.  
  301.     register int status;    /* status return */
  302.  
  303.     register int vtype;    /* type of variable to set */
  304.  
  305.     register char * sp;    /* scratch string pointer */
  306.  
  307.     char var[NVSIZE+1];    /* name of variable to fetch */
  308.  
  309.     char value[NSTRING];    /* value to set variable to */
  310.  
  311.  
  312.  
  313.     /* first get the variable to set.. */
  314.  
  315.     if (clexec == FALSE) {
  316.  
  317.         status = mlreply("Variable to set: ", &var[0], NVSIZE);
  318.  
  319.         if (status != TRUE)
  320.  
  321.             return(status);
  322.  
  323.     } else {    /* macro line argument */
  324.  
  325.         /* grab token and skip it */
  326.  
  327.         execstr = token(execstr, var);
  328.  
  329.     }
  330.  
  331.  
  332.  
  333.     /* check the legality and find the var */
  334.  
  335. sv01:    vtype = -1;
  336.  
  337.     switch (var[0]) {
  338.  
  339.  
  340.  
  341.         case '$': /* check for legal enviromnent var */
  342.  
  343.             for (vnum = 0; vnum < NEVARS; vnum++)
  344.  
  345.                 if (strcmp(&var[1], envars[vnum]) == 0) {
  346.  
  347.                     vtype = TKENV;
  348.  
  349.                     break;
  350.  
  351.                 }
  352.  
  353.             break;
  354.  
  355.  
  356.  
  357.         case '%': /* check for existing legal user variable */
  358.  
  359.             for (vnum = 0; vnum < MAXVARS; vnum++)
  360.  
  361.                 if (strcmp(&var[1], uv[vnum].u_name) == 0) {
  362.  
  363.                     vtype = TKVAR;
  364.  
  365.                     break;
  366.  
  367.                 }
  368.  
  369.             if (vnum < MAXVARS)
  370.  
  371.                 break;
  372.  
  373.  
  374.  
  375.             /* create a new one??? */
  376.  
  377.             for (vnum = 0; vnum < MAXVARS; vnum++)
  378.  
  379.                 if (uv[vnum].u_name[0] == 0) {
  380.  
  381.                     vtype = TKVAR;
  382.  
  383.                     strcpy(uv[vnum].u_name, &var[1]);
  384.  
  385.                     break;
  386.  
  387.                 }
  388.  
  389.             break;
  390.  
  391.  
  392.  
  393.         case '&':    /* indirect operator? */
  394.  
  395.             var[4] = 0;
  396.  
  397.             if (strcmp(&var[1], "ind") == 0) {
  398.  
  399.                 /* grab token, and eval it */
  400.  
  401.                 execstr = token(execstr, var);
  402.  
  403.                 strcpy(var, getval(var));
  404.  
  405.                 goto sv01;
  406.  
  407.             }
  408.  
  409.     }
  410.  
  411.  
  412.  
  413.     /* if its not legal....bitch */
  414.  
  415.     if (vtype == -1) {
  416.  
  417.         mlwrite("%%No such variable");
  418.  
  419.         return(FALSE);
  420.  
  421.     }
  422.  
  423.  
  424.  
  425.     /* get the value for that variable */
  426.  
  427.     if (f == TRUE)
  428.  
  429.         strcpy(value, itoa(n));
  430.  
  431.     else {
  432.  
  433.         status = mlreply("Value: ", &value[0], NSTRING);
  434.  
  435.         if (status != TRUE)
  436.  
  437.             return(status);
  438.  
  439.     }
  440.  
  441.  
  442.  
  443.     /* and set the appropriate value */
  444.  
  445.     status = TRUE;
  446.  
  447.     switch (vtype) {
  448.  
  449.     case TKVAR: /* set a user variable */
  450.  
  451.         if (uv[vnum].u_value != NULL)
  452.  
  453.             free(uv[vnum].u_value);
  454.  
  455.         sp = malloc(strlen(value) + 1);
  456.  
  457.         if (sp == NULL)
  458.  
  459.             return(FALSE);
  460.  
  461.         strcpy(sp, value);
  462.  
  463.         uv[vnum].u_value = sp;
  464.  
  465.         break;
  466.  
  467.  
  468.  
  469.     case TKENV: /* set an environment variable */
  470.  
  471.         status = TRUE;    /* by default */
  472.  
  473.         switch (vnum) {
  474.  
  475.         case EVFILLCOL:    fillcol = atoi(value);
  476.  
  477.                 break;
  478.  
  479.         case EVPAGELEN:    status = newsize(TRUE, atoi(value));
  480.  
  481.                 break;
  482.  
  483.         case EVCURCOL:    status = setccol(atoi(value));
  484.  
  485.                 break;
  486.  
  487.         case EVCURLINE:    status = gotoline(TRUE, atoi(value));
  488.  
  489.                 break;
  490.  
  491.         case EVRAM:    break;
  492.  
  493.         case EVFLICKER:    flickcode = stol(value);
  494.  
  495.                 break;
  496.  
  497.         case EVCURWIDTH:status = newwidth(TRUE, atoi(value));
  498.  
  499.                 break;
  500.  
  501.         case EVCBUFNAME:strcpy(curbp->b_bname, value);
  502.  
  503.                 curwp->w_flag |= WFMODE;
  504.  
  505.                 break;
  506.  
  507.         case EVCFNAME:    strcpy(curbp->b_fname, value);
  508.  
  509.                 curwp->w_flag |= WFMODE;
  510.  
  511.                 break;
  512.  
  513.         case EVSRES:    status = TTrez(value);
  514.  
  515.                 break;
  516.  
  517.         case EVDEBUG:    macbug = stol(value);
  518.  
  519.                 break;
  520.  
  521.         case EVSTATUS:    cmdstatus = stol(value);
  522.  
  523.                 break;
  524.  
  525.         case EVPALETTE:    strncpy(palstr, value, 48);
  526.  
  527.                 spal(palstr);
  528.  
  529.                 break;
  530.  
  531.         }
  532.  
  533.         break;
  534.  
  535.     }
  536.  
  537.     return(status);
  538.  
  539. }
  540.  
  541.  
  542.  
  543. /*    atoi:    ascii string to integer......This is too
  544.  
  545.         inconsistant to use the system's    */
  546.  
  547.  
  548.  
  549. atoi(st)
  550.  
  551.  
  552.  
  553. char *st;
  554.  
  555.  
  556.  
  557. {
  558.  
  559.     int result;    /* resulting number */
  560.  
  561.     int sign;    /* sign of resulting number */
  562.  
  563.     char c;        /* current char being examined */
  564.  
  565.  
  566.  
  567.     result = 0;
  568.  
  569.     sign = 1;
  570.  
  571.     while ((c = *st++)) {
  572.  
  573.         if (c == '-')
  574.  
  575.             sign *= -1;
  576.  
  577.         if (c >= '0' && c <= '9')
  578.  
  579.             result = result * 10 + c - '0';
  580.  
  581.     }
  582.  
  583.  
  584.  
  585.     return(result * sign);
  586.  
  587. }
  588.  
  589.  
  590.  
  591. /*    itoa:    integer to ascii string.......... This is too
  592.  
  593.         inconsistant to use the system's    */
  594.  
  595.  
  596.  
  597. char *itoa(i)
  598.  
  599.  
  600.  
  601. int i;    /* integer to translate to a string */
  602.  
  603.  
  604.  
  605. {
  606.  
  607.     register int digit;        /* current digit being used */
  608.  
  609.     register char *sp;        /* pointer into result */
  610.  
  611.     register int sign;        /* sign of resulting number */
  612.  
  613.     static char result[INTWIDTH+1];    /* resulting string */
  614.  
  615.  
  616.  
  617.     /* eliminate the trivial 0 */
  618.  
  619.     if (i == 0)
  620.  
  621.         return("0");
  622.  
  623.  
  624.  
  625.     /* record the sign...*/
  626.  
  627.     sign = 1;
  628.  
  629.     if (i < 0) {
  630.  
  631.         sign = -1;
  632.  
  633.         i = -i;
  634.  
  635.     }
  636.  
  637.  
  638.  
  639.     /* and build the string (backwards!) */
  640.  
  641.     sp = result + INTWIDTH;
  642.  
  643.     *sp = 0;
  644.  
  645.     while (i) {
  646.  
  647.         digit = i % 10;
  648.  
  649.         *(--sp) = '0' + digit;    /* and install the new digit */
  650.  
  651.         i = i / 10;
  652.  
  653.     }
  654.  
  655.  
  656.  
  657.     /* and fix the sign */
  658.  
  659.     if (sign == -1) {
  660.  
  661.         *(--sp) = '-';    /* and install the minus sign */
  662.  
  663.     }
  664.  
  665.  
  666.  
  667.     return(sp);
  668.  
  669. }
  670.  
  671.  
  672.  
  673. int gettyp(token)    /* find the type of a passed token */
  674.  
  675.  
  676.  
  677. char *token;    /* token to analyze */
  678.  
  679.  
  680.  
  681. {
  682.  
  683.     register char c;    /* first char in token */
  684.  
  685.  
  686.  
  687.     /* grab the first char (this is all we need) */
  688.  
  689.     c = *token;
  690.  
  691.  
  692.  
  693.     /* no blanks!!! */
  694.  
  695.     if (c == 0)
  696.  
  697.         return(TKNUL);
  698.  
  699.  
  700.  
  701.     /* a numeric literal? */
  702.  
  703.     if (c >= '0' && c <= '9')
  704.  
  705.         return(TKLIT);
  706.  
  707.  
  708.  
  709.     switch (c) {
  710.  
  711.         case '"':    return(TKSTR);
  712.  
  713.  
  714.  
  715.         case '!':    return(TKDIR);
  716.  
  717.         case '@':    return(TKARG);
  718.  
  719.         case '#':    return(TKBUF);
  720.  
  721.         case '$':    return(TKENV);
  722.  
  723.         case '%':    return(TKVAR);
  724.  
  725.         case '&':    return(TKFUN);
  726.  
  727.         case '*':    return(TKLBL);
  728.  
  729.  
  730.  
  731.         default:    return(TKCMD);
  732.  
  733.     }
  734.  
  735. }
  736.  
  737.  
  738.  
  739. char *getval(token)    /* find the value of a token */
  740.  
  741.  
  742.  
  743. char *token;        /* token to evaluate */
  744.  
  745.  
  746.  
  747. {
  748.  
  749.     register int status;    /* error return */
  750.  
  751.     register BUFFER *bp;    /* temp buffer pointer */
  752.  
  753.     register int blen;    /* length of buffer argument */
  754.  
  755.     char buf[NSTRING];    /* string buffer for some returns */
  756.  
  757.  
  758.  
  759.     switch (gettyp(token)) {
  760.  
  761.         case TKNUL:    return("");
  762.  
  763.  
  764.  
  765.         case TKARG:    /* interactive argument */
  766.  
  767.                 status = getstring(getval(&token[1]),
  768.  
  769.                        buf, NSTRING, ctoec('\n'));
  770.  
  771.                 if (status == ABORT)
  772.  
  773.                     return(errorm);
  774.  
  775.                 return(buf);
  776.  
  777.  
  778.  
  779.         case TKBUF:    /* buffer contents fetch */
  780.  
  781.  
  782.  
  783.                 /* grab the right buffer */
  784.  
  785.                 bp = bfind(getval(&token[1]), FALSE, 0);
  786.  
  787.                 if (bp == NULL)
  788.  
  789.                     return(errorm);
  790.  
  791.         
  792.  
  793.                 /* make sure we are not at the end */
  794.  
  795.                 if (bp->b_linep == bp->b_dotp)
  796.  
  797.                     return(errorm);
  798.  
  799.         
  800.  
  801.                 /* grab the line as an argument */
  802.  
  803.                 blen = bp->b_dotp->l_used;
  804.  
  805.                 if (blen > NSTRING)
  806.  
  807.                     blen = NSTRING;
  808.  
  809.                 strncpy(buf, bp->b_dotp->l_text, blen);
  810.  
  811.                 buf[blen] = 0;
  812.  
  813.         
  814.  
  815.                 /* and step the buffer's line ptr ahead a line */
  816.  
  817.                 bp->b_dotp = bp->b_dotp->l_fp;
  818.  
  819.                 bp->b_doto = 0;
  820.  
  821.  
  822.  
  823.                 /* and return the spoils */
  824.  
  825.                 return(buf);        
  826.  
  827.  
  828.  
  829.         case TKVAR:    return(gtusr(token+1));
  830.  
  831.         case TKENV:    return(gtenv(token+1));
  832.  
  833.         case TKFUN:    return(gtfun(token+1));
  834.  
  835.         case TKDIR:    return(errorm);
  836.  
  837.         case TKLBL:    return(itoa(gtlbl(token)));
  838.  
  839.         case TKLIT:    return(token);
  840.  
  841.         case TKSTR:    return(token+1);
  842.  
  843.         case TKCMD:    return(token);
  844.  
  845.     }
  846.  
  847. }
  848.  
  849.  
  850.  
  851. gtlbl(token)    /* find the line number of the given label */
  852.  
  853.  
  854.  
  855. char *token;    /* label name to find */
  856.  
  857.  
  858.  
  859. {
  860.  
  861.     return(1);
  862.  
  863. }
  864.  
  865.  
  866.  
  867. int stol(val)    /* convert a string to a numeric logical */
  868.  
  869.  
  870.  
  871. char *val;    /* value to check for stol */
  872.  
  873.  
  874.  
  875. {
  876.  
  877.     /* check for logical values */
  878.  
  879.     if (val[0] == 'F')
  880.  
  881.         return(FALSE);
  882.  
  883.     if (val[0] == 'T')
  884.  
  885.         return(TRUE);
  886.  
  887.  
  888.  
  889.     /* check for numeric truth (!= 0) */
  890.  
  891.     return((atoi(val) != 0));
  892.  
  893. }
  894.  
  895.  
  896.  
  897. char *ltos(val)        /* numeric logical to string logical */
  898.  
  899.  
  900.  
  901. int val;    /* value to translate */
  902.  
  903.  
  904.  
  905. {
  906.  
  907.     if (val)
  908.  
  909.         return(truem);
  910.  
  911.     else
  912.  
  913.         return(falsem);
  914.  
  915. }
  916.  
  917.